home *** CD-ROM | disk | FTP | other *** search
/ Web Designer 98 (Professional) / WebDesigner 1.0.iso / tutorials / tutorial / pickurl.txt < prev    next >
Encoding:
Text File  |  1997-06-15  |  5.0 KB  |  204 lines
  1. #!/usr/bin/perl
  2.  
  3. # Name: pickurl.pl
  4.  
  5. # Purpose: This is a cgi script which sends a user to
  6. # a new URL based on their choice from a input selection
  7. #
  8. # Usage: This script is portable. You can use this with
  9. # any web page that sets up the input selections as
  10. # below. This script is not specific to any particular
  11. # page.
  12. #
  13. # The URLs you want the user to go to must be passed as
  14. # values from the HTML. In order to do this, the HTML
  15. # author must include the appropriate URLs as the values
  16. # for the selection options.
  17. #
  18. # NOTE: Absolute pathnames must be used, not just
  19. # foo.html, but rather http://www.bar.com/foo.html
  20. #
  21. # Example: I want to offer a pull-down menu selection of
  22. # pages that a user can jump to. The pages are titled
  23. # Moe's Home Page, Larry's Home Page and Curly's Home
  24. # Page. The actual HTML filenames are moe.html and so on,
  25. # and they are in the home directory
  26. # (i.e. http://www.stooges.com/*). Sooooo, our HTML should
  27. # look like this:
  28. #
  29. # <FORM METHOD="POST" ACTION="pickurl.pl">
  30. # <INPUT TYPE="submit" VALUE="Select Page and Click">
  31. #
  32. # <SELECT NAME="user_options" SIZE=1>
  33. #
  34. # <OPTION VALUE="http://www.stooges.com/moe.html">Moe's Home Page
  35. # <OPTION VALUE="http://www.stooges.com/larry.html">Larry's Home Page
  36. # <OPTION VALUE="http://www.stooges.com/curly.html">Curly's Home Page
  37. #
  38. # </SELECT></FORM>
  39. #
  40. # Note that for the SELECT tag, the NAME must be "user_options"
  41. #
  42. # And it's as easy as that!
  43. #
  44. #
  45. # More Details: Ok, it's not *quite* as easy as that....
  46. #
  47. # 1) Make sure the correct perl pathway is in the first line
  48. # of the script
  49. #
  50. # 2) You might need to change extension on this script from
  51. # ".pl" to ".cgi", depending on your server's configuration.
  52. #
  53. # 3) Also, you might need to place this script in your
  54. # bin or cgi-bin directory, depending upon on your server's
  55. # configuration.
  56. #
  57. # 4) If you place this script in a directory other than the
  58. # one where the HTML file is, you need to include the correct
  59. # pathname in the HTML form. Thus, if the script resides in
  60. # a cgi-bin directory, instead of ACTION="pickurl.pl", you'd
  61. # write ACTION="http://www.stooges.com/cgi-bin/pickurl.pl"
  62. #
  63. # 5) Most likely, you can ask for help from the person(s)
  64. # that set up and/or manages the web server software; they
  65. # can help you figure out your specific situation.
  66. #
  67. # 6) Think good thoughts. It can't hurt.
  68. #
  69. #
  70. #
  71. # Script created by:
  72. # Imagesmith
  73. # http://www.imagesmith.com/imagesmith/
  74. # imagesmith@slugs.com
  75. #
  76. #
  77.  
  78.  
  79. # check and see if the POST method was used. If so,
  80. # things should be dandy. We get the info from the
  81. # cgi standard input; if not we burp and error
  82.  
  83. if ($ENV{"REQUEST_METHOD"} eq "POST")
  84.     {
  85.  
  86. # read the input off of standard input
  87.  
  88.     read(STDIN, $data, $ENV{"CONTENT_LENGTH"});
  89.  
  90. # using parseform, place values into associative
  91. # array with variables as keys and values (i.e. the URL)
  92. # as...values
  93.  
  94.     %form_values = &parseform($data);
  95.  
  96.     }
  97.     else
  98.     {
  99.     print "Content-Type: text/html\n";
  100.     print "\n";
  101.     print (<<"BadResponse"
  102. <HTML><HEAD><TITLE>Form Error!</TITLE></HEAD><BODY
  103. BGCOLOR=FFFFFF><H1><CENTER>Congratulations!</CENTER></H1>
  104. <P>You have encountered an error! <P>
  105. Please return to the previous page and try again,
  106. or contact the administrator of the site.<P>
  107. Good luck!
  108. </BODY></HTML>
  109.  
  110. BadResponse
  111.     );
  112.     exit;
  113.     };
  114.  
  115.  
  116. # These next lines are for debugging
  117. #
  118. # print "Content-Type: text/html\n";
  119. # print "\n";
  120. # print "The value of the data is $data.\n";
  121. # print "The url to be returned is $form_values{user_options}";
  122. #
  123.  
  124. #
  125. # Based on the user's choice, return a URL
  126. #
  127.  
  128. if ($form_values{user_options})
  129.     {
  130.  
  131.     print "Location: $form_values{user_options}\n\n";
  132.  
  133.     }
  134.     else
  135.     {
  136.  
  137.     print "Content-Type: text/html\n";
  138.         print "\n";
  139.         print (<<"BadResponse"
  140. <HTML><HEAD><TITLE>Form Error!</TITLE></HEAD><BODY
  141. BGCOLOR=FFFFFF><H1><CENTER>Congratulations!</CENTER></H1>
  142. <P>You have encountered an error! <P>
  143. Please return to the previous page and try again,
  144. or contact the administrator of the site.<P>
  145. Good luck!
  146. </BODY></HTML>
  147.  
  148. BadResponse
  149.         );
  150.         exit;
  151.         };
  152.  
  153.     exit;
  154.  
  155.  
  156. # This subroutine takes a url-encoded string and 
  157. # turns it into an associative array. 
  158.  
  159. sub parseform 
  160. { 
  161.    local($formthing) = @_; 
  162.    
  163.    # Expects something like: 
  164.    # foo=wow%21&bar=hello&baz=blah 
  165.    
  166.    # Split the string into each of the key-value pairs 
  167.    (@fields) = split('&', $formthing); 
  168.    
  169.    # For each of these key-value pairs, decode the value 
  170.    for $field (@fields) 
  171.    { 
  172.    
  173.      # Split the key-value pair on the equal sign. 
  174.      ($name, $value) = split('=', $field); 
  175.    
  176.      # Change all plus signs to spaces. This is an 
  177.      # remnant of ISINDEX 
  178.      $value =~ y/\+/ /; 
  179.    
  180.      # Decode the value & removes % escapes. 
  181.      $value =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; 
  182.    
  183.      # Create the appropriate entry in the 
  184.      # associative array lookup 
  185.      if(defined $lookup{$name}) 
  186.  
  187.  
  188.      { 
  189.        # If there are multiple values, separate 
  190.        # them by newlines 
  191.        $lookup{$name} .= "\n".$value; 
  192.      } 
  193.  else 
  194.      { 
  195.        $lookup{$name} = $value; 
  196.      } 
  197.    } 
  198.    
  199.    # Return the associative array 
  200.    %lookup; 
  201. } 
  202.    
  203.  
  204.